home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / resize_1 / module1.bas next >
BASIC Source File  |  1999-07-18  |  3KB  |  97 lines
  1. Attribute VB_Name = "ResizeMod"
  2. Option Explicit
  3.  
  4. Public lngMinHeight As Long
  5. Public lngMinWidth As Long
  6. Public lngMaxHeight As Long
  7. Public lngMaxWidth As Long
  8.  
  9. Public lpPrevWndProc As Long
  10. Public lngHwnd As Long
  11.  
  12. Private Const GWL_WNDPROC = -4
  13. Private Const WM_GETMINMAXINFO = &H24
  14.  
  15. Private Type POINTAPI
  16.     x As Long
  17.     y As Long
  18. End Type
  19.  
  20. Private Type MINMAXINFO
  21.     ptReserved As POINTAPI
  22.     ptMaxSize As POINTAPI
  23.     ptMaxPosition As POINTAPI
  24.     ptMinTrackSize As POINTAPI
  25.     ptMaxTrackSize As POINTAPI
  26. End Type
  27.  
  28. Private Declare Function DefWindowProc Lib "user32" Alias _
  29.    "DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, _
  30.     ByVal wParam As Long, ByVal lParam As Long) As Long
  31. Private Declare Function CallWindowProc Lib "user32" Alias _
  32.    "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
  33.     ByVal hWnd As Long, ByVal Msg As Long, _
  34.     ByVal wParam As Long, ByVal lParam As Long) As Long
  35. Private Declare Function SetWindowLong Lib "user32" Alias _
  36.    "SetWindowLongA" (ByVal hWnd As Long, _
  37.     ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  38. Private Declare Sub CopyMemoryToMinMaxInfo Lib "KERNEL32" Alias _
  39.    "RtlMoveMemory" (hpvDest As MINMAXINFO, ByVal hpvSource As Long, _
  40.     ByVal cbCopy As Long)
  41. Private Declare Sub CopyMemoryFromMinMaxInfo Lib "KERNEL32" Alias _
  42.    "RtlMoveMemory" (ByVal hpvDest As Long, hpvSource As MINMAXINFO, _
  43.     ByVal cbCopy As Long)
  44.  
  45.  
  46. Private Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, _
  47.    ByVal wParam As Long, ByVal lParam As Long) As Long
  48.     Dim MinMax As MINMAXINFO
  49.  
  50.     'Check for request for min/max window sizes.
  51.     If uMsg = WM_GETMINMAXINFO Then
  52.         'Retrieve default MinMax settings
  53.         CopyMemoryToMinMaxInfo MinMax, lParam, Len(MinMax)
  54.  
  55.         'Specify new minimum size for window.
  56.         If lngMinHeight <> 0 Then
  57.             MinMax.ptMinTrackSize.y = lngMinHeight / Screen.TwipsPerPixelY
  58.         End If
  59.         If lngMinWidth <> 0 Then
  60.             MinMax.ptMinTrackSize.x = lngMinWidth / Screen.TwipsPerPixelX
  61.         End If
  62.  
  63.         'Specify new maximum size for window.
  64.         If lngMaxHeight <> 0 Then
  65.             MinMax.ptMaxTrackSize.y = lngMaxHeight / Screen.TwipsPerPixelY
  66.         End If
  67.         If lngMaxWidth <> 0 Then
  68.             MinMax.ptMaxTrackSize.x = lngMaxWidth / Screen.TwipsPerPixelX
  69.         End If
  70.  
  71.         'Copy local structure back.
  72.         CopyMemoryFromMinMaxInfo lParam, MinMax, Len(MinMax)
  73.  
  74.         WindowProc = DefWindowProc(hw, uMsg, wParam, lParam)
  75.     Else
  76.         WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, _
  77.            wParam, lParam)
  78.     End If
  79. End Function
  80. Public Sub Unhook()
  81.     Dim temp As Long
  82.  
  83.     'Cease subclassing.
  84.     temp = SetWindowLong(lngHwnd, GWL_WNDPROC, lpPrevWndProc)
  85. End Sub
  86. Public Sub Hook()
  87.     'Start subclassing.
  88.     lpPrevWndProc = SetWindowLong(lngHwnd, GWL_WNDPROC, AddressOf WindowProc)
  89. End Sub
  90. Public Property Get hWnd() As Long
  91.     hWnd = lngHwnd
  92. End Property
  93. Public Property Let hWnd(ByVal lngNewValue As Long)
  94.     lngHwnd = lngNewValue
  95. End Property
  96.  
  97.